Proyecto de Contingencias de Vida I

Variacion Interanual

Tasa básica pasiva

### Poblaciones #### Tasas de mortalidad

Empleados de la empresa ABC

Punto A

  tablas_activos <- proyeccion_demografica_activos(base_empleados, tablas_supen)

llamamos es script con los gráficos.

source('code/graficos_activos.R')

fig_activos_vivos

Punto B

Punto C

fig_activos_muertos

Punto D

Punto E

Para esta sección, se toman las proyecciones demográficas ya hechas anteriormente.

En primer lugar, creamos las tablas en cuestión que nos ayudarán a graficar.

tabla_proy_fin <- proyeccion_financiera(tablas_activos, inflacion =  0.03)

Punto F

Punto G

Punto H

Estas son las primas para cada empleado tasa tomando en cuenta la inflación por medio de la ecuación de Fisher (1+i) = (1+tasa_real)(1+inflación), en este caso 0.0712 utilizando 0.04 tasa real y 0.03 de la inflación.

#Primas para empleados 
Primas<-Calcula_prima_individuales(base_empleados,tablas_supen,5000000,1000000,300000,0.04)

#Base de empleados de combinaciones únicas 
base_unicas<- unico(base_empleados)

#Primas para empleados, Hombre o Mujer y su respectiva edad 
Primas_unicas <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.04)
Primas_unicas <- Primas_unicas%>%
                  mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
                  select(-c(`Empleado`,`anualidad`,`beneficios`))

tabla_latex_primas_unicas <- xtable(Primas_unicas)

print(tabla_latex_primas_unicas)

## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Jun 28 18:23:18 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & Sexo & Edad & Primas \\ 
##   \hline
## 1 & Hombre & 20.00 & 448352.22 \\ 
##   2 & Hombre & 21.00 & 469172.72 \\ 
##   3 & Hombre & 22.00 & 491153.11 \\ 
##   4 & Hombre & 23.00 & 514381.83 \\ 
##   5 & Hombre & 24.00 & 538956.02 \\ 
##   6 & Hombre & 25.00 & 564983.46 \\ 
##   7 & Hombre & 26.00 & 592580.29 \\ 
##   8 & Hombre & 27.00 & 621875.39 \\ 
##   9 & Hombre & 28.00 & 653010.56 \\ 
##   10 & Hombre & 29.00 & 686142.08 \\ 
##   11 & Hombre & 30.00 & 721442.82 \\ 
##   12 & Hombre & 31.00 & 759108.88 \\ 
##   13 & Hombre & 32.00 & 799361.94 \\ 
##   14 & Hombre & 33.00 & 842450.84 \\ 
##   15 & Hombre & 34.00 & 888657.32 \\ 
##   16 & Hombre & 35.00 & 938301.33 \\ 
##   17 & Hombre & 36.00 & 991748.36 \\ 
##   18 & Hombre & 37.00 & 1049413.95 \\ 
##   19 & Hombre & 38.00 & 1111772.84 \\ 
##   20 & Hombre & 39.00 & 1179373.18 \\ 
##   21 & Hombre & 40.00 & 1252851.53 \\ 
##   22 & Hombre & 41.00 & 1332951.26 \\ 
##   23 & Hombre & 42.00 & 1420542.79 \\ 
##   24 & Hombre & 43.00 & 1516657.22 \\ 
##   25 & Hombre & 44.00 & 1622525.16 \\ 
##   26 & Hombre & 45.00 & 1739633.99 \\ 
##   27 & Hombre & 46.00 & 1869785.77 \\ 
##   28 & Hombre & 47.00 & 2015180.36 \\ 
##   29 & Hombre & 48.00 & 2178528.97 \\ 
##   30 & Hombre & 49.00 & 2363220.87 \\ 
##   31 & Hombre & 50.00 & 2573554.16 \\ 
##   32 & Hombre & 51.00 & 2815054.83 \\ 
##   33 & Hombre & 52.00 & 3094950.61 \\ 
##   34 & Hombre & 53.00 & 3422881.19 \\ 
##   35 & Hombre & 54.00 & 3812014.45 \\ 
##   36 & Hombre & 55.00 & 4280802.20 \\ 
##   37 & Hombre & 56.00 & 4855898.48 \\ 
##   38 & Hombre & 57.00 & 5577298.78 \\ 
##   39 & Hombre & 58.00 & 6507865.26 \\ 
##   40 & Hombre & 59.00 & 7752368.94 \\ 
##   41 & Hombre & 60.00 & 9499376.23 \\ 
##   42 & Hombre & 61.00 & 12125963.31 \\ 
##   43 & Hombre & 62.00 & 16511981.59 \\ 
##   44 & Hombre & 63.00 & 25297073.40 \\ 
##   45 & Hombre & 64.00 & 51679726.46 \\ 
##   46 & Mujer & 20.00 & 506114.75 \\ 
##   47 & Mujer & 21.00 & 529694.48 \\ 
##   48 & Mujer & 22.00 & 554591.62 \\ 
##   49 & Mujer & 23.00 & 580903.70 \\ 
##   50 & Mujer & 24.00 & 608739.21 \\ 
##   51 & Mujer & 25.00 & 638215.46 \\ 
##   52 & Mujer & 26.00 & 669460.47 \\ 
##   53 & Mujer & 27.00 & 702614.30 \\ 
##   54 & Mujer & 28.00 & 737833.53 \\ 
##   55 & Mujer & 29.00 & 775294.45 \\ 
##   56 & Mujer & 30.00 & 815192.97 \\ 
##   57 & Mujer & 31.00 & 857747.26 \\ 
##   58 & Mujer & 32.00 & 903202.14 \\ 
##   59 & Mujer & 33.00 & 951830.75 \\ 
##   60 & Mujer & 34.00 & 1003944.12 \\ 
##   61 & Mujer & 35.00 & 1059895.42 \\ 
##   62 & Mujer & 36.00 & 1120086.52 \\ 
##   63 & Mujer & 37.00 & 1184975.48 \\ 
##   64 & Mujer & 38.00 & 1255087.94 \\ 
##   65 & Mujer & 39.00 & 1331032.73 \\ 
##   66 & Mujer & 40.00 & 1413517.08 \\ 
##   67 & Mujer & 41.00 & 1503365.83 \\ 
##   68 & Mujer & 42.00 & 1601546.71 \\ 
##   69 & Mujer & 43.00 & 1709203.46 \\ 
##   70 & Mujer & 44.00 & 1827701.27 \\ 
##   71 & Mujer & 45.00 & 1958676.53 \\ 
##   72 & Mujer & 46.00 & 2104108.15 \\ 
##   73 & Mujer & 47.00 & 2266415.51 \\ 
##   74 & Mujer & 48.00 & 2448589.07 \\ 
##   75 & Mujer & 49.00 & 2654374.14 \\ 
##   76 & Mujer & 50.00 & 2888516.40 \\ 
##   77 & Mujer & 51.00 & 3157116.22 \\ 
##   78 & Mujer & 52.00 & 3468147.82 \\ 
##   79 & Mujer & 53.00 & 3832249.73 \\ 
##   80 & Mujer & 54.00 & 4263935.46 \\ 
##   81 & Mujer & 55.00 & 4783529.82 \\ 
##   82 & Mujer & 56.00 & 5420383.15 \\ 
##   83 & Mujer & 57.00 & 6218520.55 \\ 
##   84 & Mujer & 58.00 & 7247133.07 \\ 
##   85 & Mujer & 59.00 & 8621564.61 \\ 
##   86 & Mujer & 60.00 & 10549461.68 \\ 
##   87 & Mujer & 61.00 & 13446132.53 \\ 
##   88 & Mujer & 62.00 & 18280680.70 \\ 
##   89 & Mujer & 63.00 & 27960526.68 \\ 
##   90 & Mujer & 64.00 & 57022941.48 \\ 
##    \hline
## \end{tabular}
## \end{table}

Punto I

Para la prima nivelada, se toman la suma de las esperanzas de los beneficios futuros y se divide por la suma de las esperanza del valor presente de las primas futuras, dando como resultado la prima nivelada anual.

## [1] 1252880

Punto J

Dado que la idea de este ejercicio es reducir las primas un 10%, calculo cuál es la suma que representa el 90% de las primas originales, para acercarnos a ellas.

#Calcula cuánto es el 90% de las primas obtenidas
Primas_90_porciento <- data.frame(Empleado = Primas$Empleado,
                                  Menos_10_porciento = (Primas$Primas)*0.9)

La primera alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 5 millones durante el tiempo de ser empleado activo
# Suma asegurada de 5 millones durante pensión 
# Primer año de pensión con mensualidad de 266.520 colones
Primas1_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,5000000,5000000,266520,0.04)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica1_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas1_menos_10$Primas, 
                                    porcentaje= (Primas1_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica1_90_porciento$porcentaje)/nrow(Verifica1_90_porciento))

## [1] 90.05992

La Segunda alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 1 millón durante el tiempo de ser empleado activo
# Suma asegurada de 1 millón durante pensión 
# Primer año de pensión con mensualidad de 271.900 colones
Primas2_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,1000000,1000000,271900,0.04)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica2_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas2_menos_10$Primas, 
                                    porcentaje= (Primas2_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica2_90_porciento$porcentaje)/nrow(Verifica2_90_porciento))

## [1] 90.02407

#Primas para empleados, Hombre o Mujer y su respectiva edad 
Primas_unicas_0.05 <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.05)
Primas_unicas_0.05 <- Primas_unicas_0.05%>%
                  mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
                  select(-c(`Empleado`,`anualidad`,`beneficios`))

tabla_para_graficar_distinta_tasa <- data.frame( sexo = Primas_unicas$Sexo,
                                                 edad = Primas_unicas$Edad,
                                                 primas_normales = Primas_unicas$Primas,
                                                 primas_tasa_aumentada = Primas_unicas_0.05$Primas)

tabla_distinta_tasa_hombres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Hombre", ]
tabla_distinta_tasa_mujeres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Mujer", ]